unit TDIPageControl;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ComCtrls, Menus, TDIClasses;

type

  { TTDITabSheet }

  TTDITabSheet = class(TTabSheet)
  private
    { Private declarations }
    FChildForm: TForm;
    FParent: TWinControl;
    boolChecked: Boolean;
    function GetTabIndex: Integer; virtual;
    procedure SetChildForm(const AValue: TForm);
  protected
    { Protected declarations }
    procedure SetParent(NewParent: TWinControl); override;
  public
    { Public declarations }
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    property Parent: TWinControl read FParent write SetParent;
    property ChildForm: TForm read FChildForm write SetChildForm;
  published
    { Published declarations }
  end;

  { TTDIPageControl }

  TTDIPageControl = class(TPageControl)
  private
    { Private declarations }
    FMainMenu              : TMainMenu;
    FCaptions              : TCaptions;
    FShortCuts             : TShortCuts;
    FPagesItemIndex,
    FMaxPages              : Integer;
    FAllowMultipleInstances,
    FSmartTab              : Boolean;
    miPagesItem,
    miPage,
    miCloseTab,
    miCloseAll,
    miCloseAllButThis,
    miMore,
    miClose                : TMenuItem;
    FOwner                 : TComponent;
    FBaseForm              : TFormClass;
    function  GetActiveTabSheet: TTDITabSheet; virtual;
    function  GetTabSheet(Index: Integer): TTDITabSheet; virtual;
    procedure SetActiveTabSheet(const AValue: TTDITabSheet); virtual;
    procedure SetBaseForm(const AValue: TFormClass);
    procedure SetCaptions(const AValue: TCaptions); virtual;
    procedure SetMainMenu(const AValue: TMainMenu); virtual;
    function  MenuItemExists(ACaption: TCaption; AMainMenu: TMainMenu): Boolean; virtual;
    procedure SetShortCuts(const AValue: TShortCuts); virtual;
    procedure NextTab; virtual;
    procedure PriorTab; virtual;
    procedure SetSmartTab(const AValue: Boolean); virtual;
    procedure IndexPages; virtual;
    function  GetMenuIndex(AParent: TMenuItem; ACaption: TCaption): Integer; virtual;
    procedure SetMenuItems(AIndex: Integer); virtual;
  protected
    { Protected declarations }
    procedure miCloseTabClick(Sender: TObject); virtual;
    procedure miCloseAllClick(Sender: TObject); virtual;
    procedure miCloseAllButThisClick(Sender: TObject); virtual;
    procedure miFormClick(Sender: TObject); virtual;
    procedure miMoreClick(Sender: TObject); virtual;
    procedure KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); virtual;
  public
    { Public declarations }
    constructor Create(TheOwner: TComponent); override;
    procedure InsertMenuItem(ACaption: TCaption; AIndexPages: Boolean); virtual;
    procedure InsertMorePagesMenu; virtual;
    procedure RemoveMenuItem(AIndex: Integer); virtual;
    procedure RemovePage(AIndex: Integer; AImageIndex: Integer = 0);
    procedure CreatePageForm(const AFormClass: TFormClass; const ACaption: TCaption = '';
      const AIndex: Integer = 0; AControlBaseForm: Boolean = True); virtual;
    procedure SetPageForm(const APageIndex: Integer; const AFormClass: TFormClass;
      const ACaption: TCaption = ''; const AIndex: Integer = 0); virtual; overload;
    function  PageFormExists(const APageName: TComponentName): Boolean; virtual;
    procedure ClosePageForm(const APageName: TComponentName); virtual;
    procedure CloseCurrentPageForm; virtual;
    function  GetTabIndex(ATabSheet: TTDITabSheet): Integer; virtual;
    property Pages[Index: Integer]: TTDITabSheet read GetTabSheet;
    property BaseForm: TFormClass read FBaseForm write SetBaseForm;
  published
    { Published declarations }
    property ActivePage: TTDITabSheet read GetActiveTabSheet write SetActiveTabSheet;
    property MainMenu: TMainMenu read FMainMenu write SetMainMenu;
    property Captions: TCaptions read FCaptions write SetCaptions;
    property ShortCuts: TShortCuts read FShortCuts write SetShortCuts;
    property PagesItemIndex: Integer read FPagesItemIndex write FPagesItemIndex default 0;
    property MaxPages: Integer read FMaxPages write FMaxPages default 0;
    property AllowMultipleInstances: Boolean read FAllowMultipleInstances
      write FAllowMultipleInstances default True;
    property SmartTab: Boolean read FSmartTab write SetSmartTab;
  end;

implementation

uses
  uMore;


{ TTDITabSheet }

function TTDITabSheet.GetTabIndex: Integer;
begin
  if FParent <> nil then
    Result := (FParent as TTDIPageControl).GetTabIndex(Self);
end;

procedure TTDITabSheet.SetChildForm(const AValue: TForm);
begin
  if (FChildForm = AValue) and (FChildForm <> nil) then
    Exit;

  FChildForm := AValue;
end;

procedure TTDITabSheet.SetParent(NewParent: TWinControl);
begin
  inherited SetParent(NewParent);

  if (NewParent is TTDIPageControl) and (not boolChecked) then
    (NewParent as TTDIPageControl).InsertMenuItem(Caption, True);

  boolChecked := not boolChecked;
  FParent := NewParent;
end;

constructor TTDITabSheet.Create(TheOwner: TComponent);
begin
  boolChecked := False;
  inherited Create(TheOwner);
end;

destructor TTDITabSheet.Destroy;
begin
  if FParent <> nil then
    if (FParent as TTDIPageControl).PageCount <= 11 then
      (FParent as TTDIPageControl).RemoveMenuItem(GetTabIndex + 4);

  inherited Destroy;
end;

{ TTDIPageControl }

procedure TTDIPageControl.SetMainMenu(const AValue: TMainMenu);
begin
  if FMainMenu <> AValue then
    FMainMenu := AValue;
end;

function TTDIPageControl.GetTabSheet(Index: Integer): TTDITabSheet;
begin
  Result := TTDITabSheet(inherited Page[Index]);
end;

function TTDIPageControl.GetActiveTabSheet: TTDITabSheet;
begin
  Result := TTDITabSheet(inherited ActivePageComponent);
end;

procedure TTDIPageControl.SetActiveTabSheet(const AValue: TTDITabSheet);
begin
  ActivePageComponent := AValue;
end;

procedure TTDIPageControl.SetBaseForm(const AValue: TFormClass);
begin
  if FBaseForm <> AValue then
  begin
    FBaseForm := AValue;

    if FBaseForm <> nil then
      if PageCount = 0 then
        CreatePageForm(FBaseForm, FCaptions.BaseForm)
      else
        SetPageForm(0, FBaseForm, FCaptions.BaseForm);

    FCaptions.BaseForm := Pages[0].Caption;
  end;
end;

procedure TTDIPageControl.SetCaptions(const AValue: TCaptions);
begin
  FCaptions.Assign(AValue);
end;

procedure TTDIPageControl.InsertMenuItem(ACaption: TCaption; AIndexPages: Boolean);
begin
  if FMainMenu = nil then
    Exit;

  if not MenuItemExists(FCaptions.MenuItem, FMainMenu) then
  begin
    miPagesItem := TMenuItem.Create(FMainMenu);
    miPagesItem.Caption := FCaptions.MenuItem;
    FMainMenu.Items.Insert(FPagesItemIndex, miPagesItem);

    miCloseTab := TMenuItem.Create(FMainMenu);
    miCloseTab.Caption := FCaptions.CloseTab;
    miCloseTab.Name := 'miCloseTab';
    miCloseTab.ShortCut := FShortCuts.CloseTab;
    miCloseTab.OnClick := @miCloseTabClick;
    FMainMenu.Items[FPagesItemIndex].Add(miCloseTab);

    miCloseAllButThis := TMenuItem.Create(FMainMenu);
    miCloseAllButThis.Caption := FCaptions.CloseAllButThis;
    miCloseAllButThis.Name := 'miCloseAllButThis';
    miCloseAllButThis.ShortCut := FShortCuts.CloseAllButThis;
    miCloseAllButThis.OnClick := @miCloseAllButThisClick;
    FMainMenu.Items[FPagesItemIndex].Add(miCloseAllButThis);

    miCloseAll := TMenuItem.Create(FMainMenu);
    miCloseAll.Caption := FCaptions.CloseAllTabs;
    miCloseAll.Name := 'miCloseAll';
    miCloseAll.ShortCut := FShortCuts.CloseAllTabs;
    miCloseAll.OnClick := @miCloseAllClick;
    FMainMenu.Items[FPagesItemIndex].Add(miCloseAll);

    FMainMenu.Items[FPagesItemIndex].AddSeparator;
  end;

  FMainMenu.Items[FPagesItemIndex].Visible := True;

  case FMainMenu.Items[FPagesItemIndex].Count of
    0..13:
    begin
      miPage := TMenuItem.Create(FMainMenu);
      miPage.Caption := ACaption;
      miPage.OnClick := @miFormClick;
      FMainMenu.Items[FPagesItemIndex].Add(miPage);

      if AIndexPages then
        IndexPages;
    end;
    14: InsertMorePagesMenu;
  end;
end;

procedure TTDIPageControl.InsertMorePagesMenu;
begin
  miMore := TMenuItem.Create(FMainMenu);
  miMore.Caption := FCaptions.MorePages;
  miMore.OnClick := @miMoreClick;
  FMainMenu.Items[FPagesItemIndex].Add(miMore);
end;

procedure TTDIPageControl.RemoveMenuItem(AIndex: Integer);
begin
  if FMainMenu = nil then
    Exit;

  FMainMenu.Items[FPagesItemIndex].Items[AIndex].Free;
end;

function TTDIPageControl.MenuItemExists(ACaption: TCaption; AMainMenu:
  TMainMenu): Boolean;
var
  i: Cardinal;
begin
  Result := False;

  if AMainMenu.Items.Count = 0 then
    Exit;

  for i := 0 to Pred(AMainMenu.Items.Count) do
    Result := Result or (AMainMenu.Items[i].Caption = ACaption);
end;

procedure TTDIPageControl.SetShortCuts(const AValue: TShortCuts);
begin
  FShortCuts.Assign(AValue);
end;

procedure TTDIPageControl.NextTab;
begin
  if PageIndex <> Pred(PageCount) then
    ActivePage := Pages[PageIndex + 1]
  else
    ActivePage := Pages[0];

  Abort;
end;

procedure TTDIPageControl.PriorTab;
begin
  if PageIndex > 0 then
    ActivePage := Pages[PageIndex - 1]
  else
    ActivePage := Pages[Pred(PageCount)];

  Abort;
end;

procedure TTDIPageControl.SetSmartTab(const AValue: Boolean);
begin
  if FSmartTab <> AValue then
  begin
    FSmartTab := AValue;

    if AValue then
      Self.OnKeyDown := @KeyDown
    else
      Self.OnKeyDown := nil;
  end;
end;

procedure TTDIPageControl.IndexPages;
var
  i: Cardinal;
begin
  case PageCount of
    1..10:
    begin
      for i := 4 to Pred(FMainMenu.Items[FPagesItemIndex].Count) do
        SetMenuItems(i);
    end
  else
    for i := Pred(FMainMenu.Items[FPagesItemIndex].Count) downto 4 do
      FMainMenu.Items[FPagesItemIndex].Items[i].Free;

    for i := 0 to Pred(PageCount) do
    begin
      if i > 9 then
      begin
        InsertMorePagesMenu;
        Break;
      end;

      InsertMenuItem(Pages[i].Caption, False);
      SetMenuItems(i + 4);
    end;
  end;
end;

function TTDIPageControl.GetMenuIndex(AParent: TMenuItem; ACaption: TCaption
  ): Integer;
begin
  for Result := 0 to Pred(AParent.Count) do
  begin
    if AParent.Items[Result].Caption = ACaption then
      Break;
  end;
end;

procedure TTDIPageControl.RemovePage(AIndex: Integer; AImageIndex: Integer = 0);
begin
  if (PageCount = 1) and (FBaseForm <> nil) then
  begin
    if Pages[0].Caption <> FCaptions.BaseForm then
      SetPageForm(0, FBaseForm, FCaptions.BaseForm, AImageIndex);
  end
  else
    Pages[AIndex].Free;

  if miClose <> nil then
    miClose.Visible := PageCount > 0;
end;

procedure TTDIPageControl.SetMenuItems(AIndex: Integer);
var
  intIndex, intCaption: Integer;
begin
  intIndex := AIndex - 4;
  intCaption := AIndex - 3;

  if intCaption = 10 then
    intCaption := 0;

  if FMainMenu.Items[FPagesItemIndex].Items[AIndex].Caption = FCaptions.MorePages then
  begin
    RemoveMenuItem(GetMenuIndex(FMainMenu.Items[FPagesItemIndex], FCaptions.MorePages));
    InsertMenuItem(Page[intIndex].Caption, False);
  end;

  FMainMenu.Items[FPagesItemIndex].Items[AIndex].Caption := Format('&%d %s',
                                                                   [intCaption,
                                                                    Pages[intIndex].Caption]);
end;

procedure TTDIPageControl.miCloseTabClick(Sender: TObject);
begin
  if ActivePage is TTDITabSheet then
    RemovePage(IndexOf(ActivePage));

  if PageCount > 0 then
    IndexPages
  else
    FMainMenu.Items[FPagesItemIndex].Visible := False;
end;

procedure TTDIPageControl.miCloseAllClick(Sender: TObject);
var
  i: Cardinal;
begin
  for i := Pred(PageCount) downto 0 do
    if Pages[i] is TTDITabSheet then
      RemovePage(i);
end;

procedure TTDIPageControl.miCloseAllButThisClick(Sender: TObject);
var
  i: Cardinal;
begin
  for i := Pred(PageCount) downto 0 do
    if Pages[i] is TTDITabSheet then
      if Pages[i] <> ActivePage then
        Pages[i].Free;

  IndexPages;
end;

procedure TTDIPageControl.miFormClick(Sender: TObject);
begin
  ActivePage := Pages[FMainMenu.Items[FPagesItemIndex].IndexOf((Sender as TMenuItem)) - 4];
end;

procedure TTDIPageControl.miMoreClick(Sender: TObject);
var
  capFormCaption: TCaption;
begin
  capFormCaption := FCaptions.OpenPagesWindow;
  TfrmMore.ListTabs(Self, capFormCaption);
end;

procedure TTDIPageControl.KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  case Key of
    9:
    begin
      if Shift = [ssShift, ssCtrl] then
        PriorTab
      else if Shift = [ssCtrl] then
        NextTab;
    end;
  end;
end;

constructor TTDIPageControl.Create(TheOwner: TComponent);
begin
  FOwner := TheOwner;
  FCaptions := TCaptions.Create;
  FShortCuts := TShortCuts.Create;
  FAllowMultipleInstances := True;
  FMaxPages := 0;

  inherited Create(TheOwner);
end;

procedure TTDIPageControl.CreatePageForm(const AFormClass: TFormClass; const ACaption: TCaption;
  const AIndex: Integer; AControlBaseForm: Boolean);
var
  pgPage: TTDITabSheet;
  frmForm: TForm;
begin
  if FMaxPages > 0 then
    if PageCount = FMaxPages then
    begin
      MessageDlg('Atenção', 'O número máximo de abas foi alcançado.',
                 mtWarning, [mbOK], 0);
      Exit;
    end;

  if (PageCount = 1) and (ActivePage.Caption = FCaptions.BaseForm) and AControlBaseForm then
  begin
    SetPageForm(0, AFormClass, ACaption);
    Exit;
  end;

  if FAllowMultipleInstances or (not PageFormExists(ACaption)) then
  begin
    pgPage := TTDITabSheet.Create(Self);
    frmForm := AFormClass.Create(pgPage);
    pgPage.ChildForm := TForm(AFormClass);

    if ACaption = EmptyStr then
      pgPage.Caption := frmForm.Caption
    else
      pgPage.Caption := ACaption;

    pgPage.Parent := Self;
    pgPage.ImageIndex := AIndex;
    frmForm.Align := alClient;
    frmForm.BorderStyle := bsNone;
    frmForm.Parent := pgPage;
    frmForm.Show;
    PageIndex := pgPage.PageIndex;

    Application.ProcessMessages;
  end;

  if miClose = nil then
  begin
    miClose := TMenuItem.Create(FMainMenu);
    miClose.Caption := 'X';
    miClose.OnClick := @miCloseTabClick;
    miClose.RightJustify := True;
    FMainMenu.Items.Add(miClose);
  end;
  miClose.Visible := PageCount > 0;
end;

procedure TTDIPageControl.SetPageForm(const APageIndex: Integer; const
  AFormClass: TFormClass; const ACaption: TCaption; const AIndex: Integer);
var
  frmForm: TForm;
begin
  frmForm := AFormClass.Create(Pages[APageIndex]);

  if ACaption = EmptyStr then
    Pages[APageIndex].Caption := frmForm.Caption
  else
    Pages[APageIndex].Caption := ACaption;

  Pages[APageIndex].ImageIndex := AIndex;
  frmForm.Align := alClient;
  frmForm.BorderStyle := bsNone;
  frmForm.Parent := Pages[APageIndex];
  frmForm.Show;
  PageIndex := Pages[APageIndex].PageIndex;

  IndexPages;

  Application.ProcessMessages;
end;

function TTDIPageControl.PageFormExists(const APageName: TComponentName): Boolean;
var
  i, j: Integer;
  tsTabSheet: TTDITabSheet;
begin
  Result := False;
  tsTabSheet := nil;

  for i := 0 to Pred(PageCount) do
  begin
    if Page[i].Caption = APageName then
    begin
      Result := True;

      for j := 0 to ComponentCount - 1 do
      begin
        if Components[i] is TTDITabSheet then
          if (Components[i] as TTDITabSheet).Caption = APageName then
          begin
            tsTabSheet := (Components[i] as TTDITabSheet);
            Break;
          end;
      end;

      ActivePage := tsTabSheet;
      Break;
    end;
  end;
end;

procedure TTDIPageControl.ClosePageForm(const APageName: TComponentName);
var
  i: Integer;
begin
  for i := 0 to Pred(PageCount) do
  begin
    if Page[i].Caption = APageName then
    begin
      Page[i].Free;
      Break;
    end;
  end;

  IndexPages;
end;

procedure TTDIPageControl.CloseCurrentPageForm;
begin
  miCloseTabClick(nil);
end;

function TTDIPageControl.GetTabIndex(ATabSheet: TTDITabSheet): Integer;
var
  i: Integer;
begin
  Result := -1;

  for i := 0 to Pred(PageCount) do
  begin
    if Pages[i] = ATabSheet then
    begin
      Result := i;
      Break;
    end;
  end;
end;

end.
